home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d11 / pscreen.arc / PS-DEMO.BAS < prev    next >
Encoding:
BASIC Source File  |  1989-07-08  |  18.1 KB  |  411 lines
  1. '*** PS-Demo.BAS *************************************(C) 1988 R.W. Smetana *
  2. '
  3. '     Demo program included with P-Screen (Pro~Formance Screen Design).
  4. '
  5. '     QuickBASIC 4.0 or later required to run this.  TYPE & SEG used.
  6. '
  7. '    2 Purposes:    Demonstrate how to:
  8. '                     1.  Display screens stored in a Library.
  9. '                         - Press [H]elp to view a Help Screen.  Examine the
  10. '                           small amount of code needed to display a screen.
  11. '                     2.  Display a directory of Library Screen names.
  12. '
  13. '        To run:    Run QB, loading a Quick Library that contains:
  14. '                   - rsLoadScrn     -rsLodBin      -rsScrnRest (optional)
  15. '  
  16. '                   We include PS-DEMO.QLB with P-Screen for this purpose.
  17. '
  18. '                   Example:  QB ps-demo /l ps-demo
  19. '
  20. ' Compatibility:    QuickBasic 4.0 + only   (rsLoadScrn uses TYPE, here we use SEG)
  21. '
  22. '       History:    1st cut 12/88
  23. '
  24. '****************************************************************************
  25.  
  26. DEFINT A-Z          '... Integers ONLY.  If not, called routines will crash.
  27.  
  28. '................. .................  ................. .................
  29.  
  30. DECLARE SUB LoadQB (QBMenu%(), QB.ErrCode%)   '... included here; rest are in PS-Demo.Qlb
  31.  
  32. DECLARE SUB rsLoadScrn (Sc2%(), LibName$, FileName$, Desc$, TopRow%, TopCol%, BotRow%, BotCol%, x%, ErrCode%)
  33. DECLARE SUB rsScrnRest (TopRow%, BotRow%, SEG Array%)
  34. DECLARE SUB rsScrnRestPlus (SEG Sc1%, Top, Lft, Bot, Rht)
  35.  
  36. '...Caution:  Use rsScrnRest ONLY for full-width screens.  Registered users
  37. '   receive a Screen Restore subprogram useful for full/partial/sub screens.
  38. '   In place of rsScrnRest, use a screen restore subprogram you already have.
  39. '   But, it must be able to handle $Dynamic Integer arrays (see REdim below).
  40.  
  41. TYPE ScrLib                             '... TYPE to read Names/Descriptions
  42.     ScrName AS STRING * 8               '    of screens in a Library
  43.     Description AS STRING * 15
  44.     IgnoreMe AS STRING * 14
  45. END TYPE
  46. DIM ScreenLib AS ScrLib
  47.  
  48. '... If you prefer Field statements rather than TYPES
  49. '... FIELD #1, 8 AS ScrName$, 15 AS Description$, 14 AS IgnoreMe$
  50.  
  51. '................. .................  ................. .................
  52.  
  53. LibName$ = "P-SCREEN"           '... Display all screens from P-Screen.Psl
  54.  
  55. ON ERROR GOTO CantFindLibrary   '... This demo aborts if P-Screen.Psl isn't found.
  56.  
  57. '... 1st, see if "P-Screen.Psl" exists.  If not, stop.
  58.  
  59.     CLOSE : OPEN LibName$ + ".Psl" FOR INPUT AS #1  '... Just checking.  Your
  60.     CLOSE                                           '    programs MUST ensure
  61.                                                     '    Libraries exist BEFORE
  62.                                                     '    calling our routines
  63.  
  64. REDIM QBMenu%(1)                                    '... QBMenuDemo has Details
  65. CALL LoadQB(QBMenu%(), QB.ErrCode)                  '    LoadQB is in PS-Demo.Qlb
  66.  
  67. '................. .................  ................. .................
  68.  
  69. '... Main Menu
  70.    DO
  71.     CLS
  72.       PRINT TAB(31); "P~F  Screen  Demo"
  73.       a$ = "Do you want:  Help/Directory/QB Demo?" '... Help displays a Help Screen
  74.       b$ = "Press  [H]elp, [D]irectory, [Q]B"       '... Directory displays screens/descriptions
  75.                                                 '    in P-Screen.Psl.  Both are useful.
  76.                                                 '    See QBDemo for details on it
  77.       c$ = "Esc] = Exit this Demo"
  78.       GOSUB MidMessage                          '... print the Main Menu
  79.  
  80.       Option$ = UCASE$(INPUT$(1))
  81.       CLS
  82.  
  83.       ON INSTR("HDQ", Option$) GOSUB Help, Directory, QBDemo '... do it or exit
  84.  
  85.    LOOP WHILE Option$ <> CHR$(27)
  86.  
  87. END
  88. '................. .................  ................. .................
  89. Help:    '... demonstrate how to Display Library Screen/interpret ErrCode
  90. '................. .................  ................. .................
  91.        LibName$ = "P-Screen"            '... P-Screen.Psl comes with P-Screen
  92.     ScreenName$ = "QUIKREF1"            '... 1st P-Screen Help Screen
  93.  
  94.     REDIM Array%(1)                     '... Load screen into Array%(), then
  95.                                         '    restore screen from Array%(). Don't
  96.                                         '    use Dim.  It's REdimension as needed.
  97.     GOSUB DisplayScreen                 '... That's it.  See below for how it's done
  98. RETURN
  99.  
  100. '................. .................  ................. .................
  101. DisplayScreen:
  102.  
  103. '... If we got here, LibName$ + ".Psl" is available.  Load ScreenName$
  104. '................. .................  ................. .................
  105.  
  106.     LibName$ = UCASE$(LibName$)
  107.     ScreenName$ = UCASE$(ScreenName$)   '... Screen names stored in Upper Case
  108.   
  109.     CALL rsLoadScrn(Array%(), LibName$, ScreenName$, Desc$, TopRow, TopCol, BotRow, BotCol, x, ErrCode)
  110.                                     '... Notes:  You needn't Open/Close
  111.                                     '    the Library File.  That's done in
  112.                                     '    rsLoadScrn.
  113.                                     '    TopRow/TopCol/BotRow/BotCol define
  114.                                     '    the Original coordinates of the screen.
  115.                                     '    (1/1/25/80 = Rows 1-25, Columns 1-80).
  116.                                     '    ErrCode has 3 possible values:::
  117.     SELECT CASE ErrCode
  118.  
  119.      CASE IS < 0                 'Negative ErrCode means Error (usually -99 or -1)
  120.         BEEP
  121.         IF ErrCode = -99 THEN               '... screen NOT in Library
  122.            PRINT TAB(20); "["; ScreenName$; "]  was NOT in "; LibName$; ".Psl";
  123.         ELSE                                '... error loading it (probably -1)
  124.            PRINT " Error loading "; ScreenName$;
  125.         END IF
  126.  
  127.         GOSUB pause
  128.  
  129.      CASE IS >= 0                       '...everything went OK
  130.                                         '... Caution:  rsScrnRest is ONLY
  131.                                         '    for full-width screens.
  132.                                         '    Use any screen restore subprogram you want.
  133.        
  134.         CALL rsScrnRest(TopRow%, BotRow%, SEG Array%(1))
  135.         ERASE Array%                    '... no longer needed
  136.        
  137.         GOSUB ShowInfo                  '... for your information
  138.  
  139.         d$ = INPUT$(1)                  '... pause
  140.  
  141.      CASE ELSE
  142.     END SELECT
  143. '................. .................  ................. .................
  144. RETURN
  145. '................. .................  ................. .................
  146. ShowInfo:           '... display info returned by rsLoadScrn
  147. '................. .................  ................. .................
  148.       
  149.     COLOR 0, 7
  150.     LOCATE 7, 12: PRINT "┌" + STRING$(54, 196); "┐"
  151.         FOR x = 1 TO 8: LOCATE , 12: PRINT "│"; SPC(54); "│": NEXT
  152.     LOCATE , 12: PRINT "└" + STRING$(54, 196); "┘"
  153.  
  154.     LOCATE 7, 24: PRINT "rsLoadScrn reported the following:"
  155.     LOCATE 9, 16: PRINT "         Error Code: "; ErrCode; "  It went just fine!"
  156.     LOCATE , 16:  PRINT "            Library:  "; LibName$
  157.     LOCATE , 16:  PRINT "             Screen:  "; ScreenName$
  158.     LOCATE , 16:  PRINT "        Description:  "; Desc$
  159.     LOCATE , 16:  PRINT "   Top Row / Column: "; TopRow; TopCol
  160.     LOCATE , 16:  PRINT "Bottom Row / Column: "; BotRow; BotCol
  161.  
  162.     LOCATE 16, 31: PRINT "Press a key . . .";
  163.     COLOR 7, 0
  164.  
  165. RETURN
  166.  
  167. '................. .................  ................. .................
  168. Directory:  '... Demonstrate how to review Library Screen Names/Descriptions
  169. '................. .................  ................. .................
  170.            
  171.     CLOSE
  172.     OPEN Path$ + LibName$ + ".PSL" FOR RANDOM AS #1 LEN = LEN(ScreenLib)
  173.    
  174.     PRINT TAB(26); "Screens Stored in "; LibName$; ".Psl": PRINT
  175.     PRINT TAB(7); "Name"; TAB(17); "Description"; TAB(49); "Name"; TAB(59); "Description"
  176.     PRINT
  177.  
  178.     FOR x = 2 TO 51                                 '... start at record #2
  179.         GET #1, x, ScreenLib                        '... using TYPE format/NOT Field
  180.             a$ = LTRIM$(RTRIM$(ScreenLib.ScrName))    '... strip blanks
  181.             IF a$ = "" THEN EXIT FOR
  182.             PRINT USING "  ##. "; x - 1;
  183.             PRINT LEFT$(a$ + SPACE$(10), 10); ScreenLib.Description,
  184.         NEXT
  185.     CLOSE
  186.  
  187.     GOSUB pause
  188.  
  189. RETURN
  190. '................. .................  ................. .................
  191. pause:
  192. '................. .................  ................. .................
  193.     LOCATE 24, 20: PRINT SPC(12); "Press a key . . ."; SPC(15);
  194.     a$ = INPUT$(1)                      '... pause
  195.  
  196. RETURN
  197. '................. .................  ................. .................
  198. QBDemo:     '... Demonstrate displaying screens from an array.  The array
  199.             '    QBMenu%() was loaded with screens from P-Screen.Psl when
  200.             '    you first ran this --- Call LoadQB (QBMenu%(), QB.ErrCode).
  201.             '    QBMenu%() needs about 5800 bytes of FAR memory.  Loading
  202.             '    these menus from a screen library into an Integer array
  203.             '    saves you a few '000 bytes of valuable string/data space.
  204. 'NOTE:  If strange things happen when you run this, P-Screen.Psl was
  205. '       probably altered.  The Row/Column and QBMenu% offsets BELOW may no
  206. '       longer correspond to where they were loaded.
  207.  
  208. '................. .................  ................. .................
  209.  
  210.     IF QB.ErrCode <> 0 THEN     '... error occurred loading screens
  211.         PRINT TAB(12); "Error occurred loading screens earlier.  Can't do demo."
  212.         BEEP: d$ = INPUT$(1): RETURN
  213.     END IF
  214.  
  215. '...Alt-key scan codes for Alt- : : :
  216.     'F (!), E (Chr$(18)), V (/), S (31), R (19), D (" "), O (24), H (#)
  217.  
  218.    AltKey$ = "!/ #" + CHR$(18) + CHR$(31) + CHR$(19) + CHR$(24)
  219.  
  220.  
  221.      DO                                             '... Outer Loop
  222.         CLS
  223.         CALL rsScrnRestPlus(SEG QBMenu%(QBMenu%(1)), 1, 1, 1, 80) '  see note below re: Offsets
  224.  
  225.         LOCATE 19, 3: PRINT "This demonstrates displaying menus via an Integer array.  These menus are"
  226.         LOCATE , 3:   PRINT "NOT displayed from disk.  They were loaded into QBMenu%() when you ran this."
  227.         LOCATE , 3:   PRINT "See 'Performance Hints' in your manual.  Screens displayed via rsRestPlus."
  228.  
  229.         LOCATE 24, 20: PRINT "Press Alt- F/E/V/S/R/D/O/H    [Esc] = Exit";
  230.  
  231.         DO                                         '... get a key
  232.           d$ = "": d$ = INKEY$
  233.         LOOP WHILE d$ <> CHR$(27) AND LEN(d$) < 2  '    we only want Extended Keys
  234.  
  235.         IF d$ = CHR$(27) THEN EXIT DO   '... exit Outer Loop on Esc
  236.  
  237.         d$ = RIGHT$(d$, 1)              '... It's Extended, take 2nd key/Strip Chr$(0)
  238.        
  239.         SELECT CASE d$                  '... NOTICE:  We reserved the 1st 10
  240.                                         '    elements in QBMenu%() to store
  241.                                         '    the offset into QBMenu% where
  242.                                         '    each screen BEGINS.
  243.                                         '    See Sub LoadQB for details
  244.  
  245.           CASE "!"          '... Alt-F (File)
  246.               CALL rsScrnRestPlus(SEG QBMenu%(QBMenu%(2)), 1, 2, 18, 23)
  247.               GOSUB pause
  248.           CASE CHR$(18)     '... Alt-E (Edit)
  249.               CALL rsScrnRestPlus(SEG QBMenu%(QBMenu%(3)), 1, 8, 11, 32)
  250.               GOSUB pause
  251.           CASE "/"          '... Alt-V (View)
  252.               CALL rsScrnRestPlus(SEG QBMenu%(QBMenu%(4)), 1, 14, 12, 38)
  253.               GOSUB pause
  254.           CASE CHR$(31)     '... Alt-S (Search)
  255.               CALL rsScrnRestPlus(SEG QBMenu%(QBMenu%(5)), 1, 20, 8, 47)
  256.               GOSUB pause
  257.           CASE CHR$(19)     '... Alt-R (Run)
  258.               CALL rsScrnRestPlus(SEG QBMenu%(QBMenu%(6)), 1, 28, 12, 50)
  259.               GOSUB pause
  260.           CASE " "          '... Alt-D (Debug)
  261.               CALL rsScrnRestPlus(SEG QBMenu%(QBMenu%(7)), 1, 33, 16, 63)
  262.               GOSUB pause
  263.           CASE CHR$(24)     '... Alt-O (Options)
  264.               CALL rsScrnRestPlus(SEG QBMenu%(QBMenu%(8)), 1, 47, 8, 66)
  265.               GOSUB pause
  266.           CASE "#"          '... Alt-H (Help)
  267.               CALL rsScrnRestPlus(SEG QBMenu%(QBMenu%(9)), 1, 52, 7, 80)
  268.               GOSUB pause
  269.           CASE ELSE         'nada
  270.  
  271.         END SELECT
  272.  
  273.      LOOP
  274.  
  275. RETURN
  276. '................. .................  ................. .................
  277. CantFindLibrary:    '... couldn't find LibName$ + ".Psl"
  278. '................. .................  ................. .................
  279.     CLS : CLOSE
  280.  
  281.     PRINT TAB(18); "Can't find "; LibName$ + ".Psl.  Press a key . . .";
  282.     BEEP: a$ = INPUT$(1): END
  283.  
  284. '................. .................  ................. .................
  285.  
  286. MidMessage:
  287.     COLOR 0, 7
  288.     LOCATE 8, 20: PRINT "┌"; STRING$(39, "─"); "┐"
  289.     FOR x = 9 TO 13
  290.         LOCATE , 20: PRINT "│"; SPACE$(39); "│"
  291.     NEXT
  292.     LOCATE , 20: PRINT "└"; STRING$(39, "─"); "┘"
  293.     LOCATE 10, 21: PRINT STRING$(38, "─")
  294.  
  295.     LOCATE 9, 22:  PRINT a$
  296.     LOCATE 14, 22: PRINT "["; c$; "]"
  297.     LOCATE 12, 22: PRINT b$;
  298.  
  299.     a$ = "": b$ = "": c$ = ""
  300.     COLOR 7, 0
  301. RETURN
  302.  
  303. '................. .................  ................. .................
  304. SUB LoadQB (QBMenu%(), QB.ErrCode)
  305. '................. .................  ................. .................
  306. '   Purpose:  1) Load ALL QB-Type screens from P-Screen.Psl into QBMenu%()
  307. '                  for fast display later on.  Press [Q]B at the menu.
  308. '             2) Demonstrate how to do this in your programs -- for those
  309. '                  situations needing Instant screens/subscreens
  310. '
  311. '     Calls:  Run only with LoadScrn.obj & rsLodBin.obj in your Quick Library
  312. '................. .................  ................. .................
  313. '... setup
  314. '................. .................  ................. .................
  315.     CLS
  316.   
  317.     REDIM QBMenu%(1 TO 4200)    '... Just 4200 bytes FAR memory needed to store
  318.                                 '    all qb screens.  Saves lots of string space.
  319.                                 '    In your programs, you can calculate (4200) on the fly.
  320.     REDIM Tmp%(1)               '... Temporary storage for each screen
  321.   
  322.     CONST LibNm$ = "P-SCREEN"   '... Same Screen Library for all loads.
  323.   
  324.     OffSet = 10                 '... Offset into QBMenu% to load each new screen.
  325.                                 '    We have 9 screens. Reserve 10 elements to store
  326.                                 '     offset of each screen for re-displaying.
  327.     ScreenNumber = 1            '    To store Offset for re-displaying screen.
  328.  
  329. '................. .................  ................. .................
  330. '... start loading screens (1 to 9)
  331. '................. .................  ................. .................
  332.  
  333.     ScrnN$ = "QB-MAIN"
  334.     CALL rsLoadScrn(Tmp%(), LibNm$, ScrnN$, Desc$, TopRow, TopCol, BotRow, BotCol, x, ErrCode)
  335.     GOSUB CalcOffset
  336.   
  337.     ScrnN$ = "FILE-1"
  338.     CALL rsLoadScrn(Tmp%(), LibNm$, ScrnN$, Desc$, TopRow, TopCol, BotRow, BotCol, x, ErrCode)
  339.     GOSUB CalcOffset
  340.   
  341.     ScrnN$ = "EDIT-1"
  342.     CALL rsLoadScrn(Tmp%(), LibNm$, ScrnN$, Desc$, TopRow, TopCol, BotRow, BotCol, x, ErrCode)
  343.     GOSUB CalcOffset
  344.   
  345.     ScrnN$ = "VIEW-1"
  346.     CALL rsLoadScrn(Tmp%(), LibNm$, ScrnN$, Desc$, TopRow, TopCol, BotRow, BotCol, x, ErrCode)
  347.     GOSUB CalcOffset
  348.   
  349.     ScrnN$ = "SEARCH-1"
  350.     CALL rsLoadScrn(Tmp%(), LibNm$, ScrnN$, Desc$, TopRow, TopCol, BotRow, BotCol, x, ErrCode)
  351.     GOSUB CalcOffset
  352.  
  353.     ScrnN$ = "RUN-1"
  354.     CALL rsLoadScrn(Tmp%(), LibNm$, ScrnN$, Desc$, TopRow, TopCol, BotRow, BotCol, x, ErrCode)
  355.     GOSUB CalcOffset
  356.   
  357.     ScrnN$ = "DEBUG-1"
  358.     CALL rsLoadScrn(Tmp%(), LibNm$, ScrnN$, Desc$, TopRow, TopCol, BotRow, BotCol, x, ErrCode)
  359.     GOSUB CalcOffset
  360.   
  361.     ScrnN$ = "OPTNS-1"
  362.     CALL rsLoadScrn(Tmp%(), LibNm$, ScrnN$, Desc$, TopRow, TopCol, BotRow, BotCol, x, ErrCode)
  363.     GOSUB CalcOffset
  364.   
  365.     ScrnN$ = "HELP-1"
  366.     CALL rsLoadScrn(Tmp%(), LibNm$, ScrnN$, Desc$, TopRow, TopCol, BotRow, BotCol, x, ErrCode)
  367.     GOSUB CalcOffset
  368.  
  369. '... NOTE: UNComment next line (& line near end) if you want to see stats as screens are loaded
  370.   
  371.    ''PRINT : PRINT TAB(4); "Press a key . . .";
  372.    ''d$ = INPUT$(1)   'pause  '... see below, if you print stats, pause before exit
  373. '................. .................  ................. .................
  374. EXIT SUB            '... all done
  375. '................. .................  ................. .................
  376.  
  377. '................. .................  ................. .................
  378. CalcOffset:         '... this does the actual work:  find the right spot
  379.                     '    (Offset) for each new screen, copy screen to QBMenu%,
  380.                     '    then store Offset in QBMenu% for displaying
  381. '................. .................  ................. .................
  382. IF ErrCode < 0 THEN QB.ErrCode = -99: EXIT SUB   '...tsk tsk, jumping out of a gosub.
  383.                                                  '   just for demo.  do gracefully in your program.
  384.  
  385.     OffSet = OffSet + ScrnSize '... Offset into QBMenu% to load each new screen.
  386.                                '    Starts = 10; bumped by ScrnSize.
  387.                                '    For 1st screen, ScrnSize = 0 so Offset = 10
  388.  
  389.     ScrnSize = ((BotRow - TopRow) + 1) * ((BotCol - TopCol) + 1)'... Size of this screen
  390.  
  391.     FOR x = 1 TO UBOUND(Tmp%)           '... Copy it into QBMenu%
  392.  
  393.         IF x + OffSet > UBOUND(QBMenu%) THEN EXIT FOR   '... just in case
  394.  
  395.         QBMenu%(x + OffSet) = Tmp%(x)   '    NOTE: 1st screen begins at 11
  396.     NEXT                                '    (Offset+x  or 10+1)
  397.  
  398.     QBMenu%(ScreenNumber) = OffSet + 1  '... '+1' because we add x in For..Next
  399.                                         '    See QBDemo to see how QBMenu%(1-10) are used.
  400.     ScreenNumber = ScreenNumber + 1     '... bump it for the next screen
  401.  
  402.  
  403. '... NOTE: UNComment next line (& Pause above) if you want to see stats as screens are loaded
  404.  
  405. '' PRINT USING "   \        \ #####  #####       TopRow, TopCol, BotRow, BotCol  ## ## ## ##"; ScrnN$; ScrnSize; OffSet + 1; TopRow; TopCol; BotRow; BotCol
  406.  
  407. RETURN
  408.  
  409. END SUB
  410.  
  411.